perm filename MOVE.FAI[NEW,LCS]2 blob sn#155901 filedate 1975-04-17 generic text, type T, neo UTF8
00100		TITLE	MOVE
00200		ENTRY	GETPTS,MOVIT,OUTLIM
00300		EXTERNAL .COMM.,XRN,KJY,PTR,POSI
00400	
00500	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300	
01400	; 	SUBROUTINE GETPTS
01500	;	DIMENSION N(500),NP(500)
01600	;	COMMON/XRN/RN(4000)  /KJY/ K,J
01700	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
01800	;	1/PTR/PWDS(250),ITEM,LL,I,IX
01900	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
02000	;	1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
02100	
02200	GETPTS:	0		;CALL GETPTS(N)
02300		SETZ	J,	;	J=0
02400		SETZ	K,	;	K=0
02500		MOVE 	JJ2,POSI+=8
02600		MOVE	R2,.COMM.
02700	;;	SETZ	X,
02710		MOVE	X,@(16)
02720		SOS	X
02800		MOVEI	M,PTR	;	DO 1 M=1,ITEM
02810		ADDI	M,(X)
02900	G1:	AOJ	X,
03000		MOVE	L,(M)
03100		FIXX(L)
03200		MOVEI	R,XRN		;L=PWDS(M)
03300		ADDI	R,(L)		;IF(RTLINE(L))GO TO 1
03400		MOVE	1,1(R)		;RN(L+2)
03500		CAML	R2,[=5.0]
03600		JRST	GZ
03700		CAME	R2,1	
03800		JRST 	GX
03900	GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
04000		JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
04100		CAME	A,(R)
04200		JRST	GX
04300	;  CHECK CODE NUM
04400	G9:	MOVE	A,2(R)		;IF(R6.NE.RY)GO TO 1
04500		CAMLE	A,.COMM.+6
04600		JRST	G2	;9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
04700		CAMGE	A,.COMM.+5	;R4
04800		JRST	G2
04900	
05000		SKIPG	JJ2
05100		MOVE	JJ2,X
05200		AOJ	J,
05300	;  IN LIMITS?
05400		MOVEI	A,XRN+=2498	;J=J+1
05500		ADDI	A,(J)
05600		MOVEI	0,(L)
05700		AOJ	K,		;K=K+1
05800		MOVEI	1,XRN+=2998
05900		ADDI	1,(K)		;NP(K)=L
06000		MOVEM	0,(1)
06100		ADDI	0,3		;N(J)=L+3
06200		MOVEM	0,(A)
06300	;  NP IS FOR USE IN JUSTIFY ROUTINE
06400	G2:	MOVE	RY,(R)	;2	IF(RY.LT.4)GO TO 1
06500		CAMGE	RY,[=4.0]
06600		JRST	GX
06700		CAMLE	RY,[=7.0]
06800		JRST	GX		;IF(RY.GT.7)GO TO 1
06900	;  TWO-ENDED ITEM?
07000		MOVE	RZ,-1(R)	;RZ=RN(L)
07100	;  WD CNT
07200		CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
07300		JRST	G4
07400		CAMN	RY,[=5.0]
07500		JRST	G5
07600		CAMN	RY,[=6.0]
07700		JRST	G6
07800		CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
07900		JRST	G5		; THERE IS A TRILL WIGGLE
08000		JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
08100	G4:	CAMG	RZ,[=2.0]	;7	IF(RZ.GT.3)GO TO 5
08200		JRST	GX
08300		JRST	G5		;GO TO 1
08400	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
08500		JRST	G8
08600	;;	MOVEI	1,XRN		;IF(RN(L+10).LT.30)GO TO 8
08700	;;	ADDI	1,(L)
08800	;;	MOVE	1,11(1)
08850		MOVE	1,=9(R)
08900		CAMGE	1,[=30.0]
09000		JRST	G8
09100		MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
09200		CAMLE	A,.COMM.+6
09300		JRST	G8
09400		CAMGE	A,.COMM.+5
09500		JRST	G8
09600		SKIPG	JJ2
09700		MOVE	JJ2,X
09800		AOJ	J,
09900	;  IN LIMITS?
10000		MOVEI	A,XRN+=2498	;J=J+1
10100		ADDI	A,(J)
10200		MOVEI	0,(L)		;J=J+1
10300		ADDI	0,=8		;N(J)=L+8
10400		MOVEM	0,(A)
10500	G8:	CAMGE	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
10600		JRST 	G5
10602		MOVE	A,6(R)		;IF(RN(L+7))GO TO G8B
10604		JUMPL	A,G8B		; P7 IS NEG FOR TREMOLO
10610		MOVE	A,7(R)		;IF(RN(L+8).NE.0)GO TO G8B
10620		JUMPN	A,G8B
10622		CAMGE	RZ,[=8.0]
10624		JRST	G5		;IF(RZ.LT.8)GO TO G5
10630		MOVE	A,=9(R)		;IF(RN(L+10).EQ.0)GO TO G5
10640		JUMPE	A,G5		;PASSES NUMBER OVER BEAM.
10700	G8B:	MOVE	A,8(R)
10800		CAMLE	A,.COMM.+6
10900		JRST	G5
11000		CAMGE	A,.COMM.+5	;R4
11100		JRST	G5
11200	
11300		SKIPG	JJ2
11400		MOVE	JJ2,X
11500		AOJ	J,		;J=J+1
11600	;  IN LIMITS?
11700		MOVEI	A,XRN+=2498	;J=J+1
11800		ADDI	A,(J)
11900		MOVEI	0,(L)
12000		ADDI	0,=9		;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
12100		MOVEM	0,(A)		;N(J)=L+9
12200	G5:	MOVE	A,5(R)
12300		CAMLE	A,.COMM.+6
12400		JRST	GX
12500		CAMGE	A,.COMM.+5	;R4
12600		JRST	GX
12700	
12800		SKIPG	JJ2
12900		MOVE	JJ2,X
13000		AOJ	J,
13100	;  IN LIMITS?
13200		MOVEI	A,XRN+=2498	;J=J+1
13300		ADDI	A,(J)
13400		MOVEI	0,(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
13500		ADDI	0,6		;N(J)=L+6
13600		MOVEM	0,(A)
13700	GX:	CAMGE	X,PTR+=250	;1	CONTINUE
13800		AOJA	M,G1
13900		MOVEM	JJ2,POSI+=8
14000		MOVEM	J,KJY+1
14100		MOVEM	K,KJY
14200		JRA	16,1(16)
14300	
14400	;	SUBROUTINE MOVIT
14500	;	DIMENSION N(500)
14600	;	COMMON/XRN/RN(4000)  /KJY/ DONT,J
14700	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
14800	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
14900	;	1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
15000	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
15100		MOVE	R,.COMM.+=10
15200		FSBR	R,.COMM.+=9
15300		MOVE	RY,.COMM.+6
15400		FSBR	RY,.COMM.+5
15500		FDVR	R,RY
15600		MOVEI	L,XRN+=2499	;	DO 1 K=1,J
15700		SETZ	K,
15750		MOVE	0,.COMM.+=10	; SET UP R9
15800	M1:	MOVE	X,L	       ;	L=N(K)
16000		MOVE	A,(X)
16100		MOVEI 	R2,XRN		;RA=RN(L)
16200		ADDI	R2,(A)
16300		MOVEI	RZ,(R2)
16400		MOVE	R2,-1(R2)
16500		CAMGE	R2,.COMM.+5	;IF(OUTLIM(R4,R5,RA))GO TO 1
16600		JRST 	MX
16700		CAMLE	R2,.COMM.+6
16800		JRST	MX
17000		JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
17100		FSBR	R2,.COMM.+5
17200		FMPR	R2,R 
17300	M2: 	FADR	R2,.COMM.+=9	;	RN(L)=R8+RA
17400		MOVEM	R2,-1(RZ)
17500	MX:	AOJ	K,		;1	CONTINUE
17600		CAMGE	K,KJY+1
17700		AOJA	L,M1
17800		JRA	16,(16)
17900	
18000	OUTLIM:	0	;	FUNCTION OUTLIM(I,J)
18100		SETO	0,	;	OUTLIM=-1
18200		MOVE	4,.COMM.+5	;	IF(RN(I+J).LT.R4)RETURN
18220		MOVEI	2,XRN
18240		ADD	2,@(16)
18260		ADD	2,@1(16)
18280		CAMLE	4,-1(2)
18290		JRA	16,2(16)
18300		MOVE	5,.COMM.+6	;	IF(RN(I+J).GT.R5)RETURN
18320		CAMGE	5,-1(2)
18340		JRA	16,2(16)
18360		SETZ	0,		;	OUTLIM=0 
18380		JRA	16,2(16)
18400	
18420		END